home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / ptool.arc / PTOOLTIM.INC < prev    next >
Text File  |  1985-06-06  |  13KB  |  364 lines
  1. { PTOOLTIM.INC   Copyright 1984  R D Ostrander                   Version 1.0
  2.                                  Ostrander Data Services
  3.                                  5437 Honey Manor Dr
  4.                                  Indianapolis  IN  46241
  5.  
  6.  These Turbo Pascal functions are time manipulation tools used to Convert
  7.  HH:MM:SS Strings, Change HH:MM:SS Strings to and from Decimal Days, Hours,
  8.  Minutes, or Seconds, Add numbers to times, Find the difference between times,
  9.  and to Retrieve the current (system) time.
  10.  
  11.  This program has been placed in the Public Domain by the author and copies
  12.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  13.  Use of these subroutines in a program for sale or for commercial purposes in
  14.  a place of business requires a $20 fee be paid to the author at the address
  15.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  16.  encourage further development of this and similar programs. With payment you
  17.  will be able to receive update notices, diskettes and printed documentation
  18.  of this and other PTOOLs from Ostrander Data Services.
  19.  
  20.  
  21.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  22.  
  23.  Turbo Pascal is a Copyright of Borland International Inc.
  24.  
  25. Functions available in PTOOLTIM.INC are:
  26.  
  27.                                (Result)
  28.  
  29.  PTTValid  (String)          : Boolean - True if argument is valid time
  30.  PTTHtoD   (String)          : Real    - Convert argument (HH:MM:SS String) to
  31.                                          a Decimal Time
  32.  PTTDtoH   (Real)            : String  - Convert argument (Decimal Time) to a
  33.                                          HH:MM:SS String
  34.  PTTHtoH   (String)          : String  - Convert argument (HH:MM:SS String) to
  35.                                          HH:MM:SS String in display format.
  36.  PTTAdd    (String, Real)    : String  - Add argument-2 number of Days, Hours
  37.                                          Minutes or Seconds (depending on
  38.                                          Decimal Time Type) to argument-1
  39.                                          (HH:MM:SS String) and express result
  40.                                          as a HH:MM:SS String
  41.  PTTComp  (String, String)  : Real    - Subtract argument-2 (HH:MM:SS String)
  42.                                          from argument-1 (HH:MM:SS String)
  43.                                          giving number of Days, Hours, Minutes
  44.                                          or Seconds (depending on Decimal Time
  45.                                          Type)
  46.  PTTHCurr                    : String  - Current (system) Time as a HH:MM:SS
  47.                                          String
  48.  PTTDCurr                    : Real    - Current (system) Time as Decimal
  49.                                          Days, Hours, Minutes or Seconds
  50.                                          (depending on Decimal Time Type)   }
  51.  
  52.  
  53.  
  54. { Constant Values  (Parameters) Begin Here ******************************** }
  55.  
  56.  
  57. TYPE
  58.  
  59.      PTOOLTIM_Str_11   = String [11];
  60.      PTOOLTIM_Elements = Array [1..4] of String [11];
  61.  
  62.  
  63. CONST
  64.  
  65.    { HH:MM:SS String     A string expression of up to 11 characters.
  66.      ---------------     example:  12:02:54 am
  67.  
  68.                          The style to display the elements (HH, MM, SS)
  69.                          is determined by the parameters below.
  70.  
  71.                          As an argument, the time is passed as a string
  72.                          expression with 3 or 4 elements separated by at
  73.                          least one of the characters  / - , . ' ; : ( )
  74.                          or a space.                                         }
  75.  
  76.                                            {   HH:MM:SS String parameters    }
  77.                                            {*********************************}
  78.  PTOOLTIM_HH_Disp   : Byte        = 12;    { Hour Display format             }
  79.                                            {   12    = 12 hour format        }
  80.                                            {   24    = 24 hour format        }
  81.  PTOOLTIM_SS_Disp   : Char        = 'S';   { Seconds Display format          }
  82.                                            {   'S'   = Display Seconds       }
  83.                                            {   ' '   = Display HH:MM only    }
  84.                                            {*********************************}
  85.  
  86.  
  87.    { Decimal Time     A Real number in either of four formats:
  88.      ------------        D = Decimal Days
  89.                          H = Decimal Hours
  90.                          M = Decimal Minutes
  91.                          S = Decimal Seconds }
  92.  
  93.                                            {      Decimal Time parameter     }
  94.                                            {*********************************}
  95.  PTOOLTIM_D_Type    : Char        = 'M';   { Decimal Time Type               }
  96.                                            {*********************************}
  97.  
  98.  
  99. { ****** Areas for internal use follow ****** }
  100.  
  101.  PTOOLTIM_Element   : PTOOLTIM_Elements = (' ', ' ', ' ', ' ');
  102.  PTOOLTIM_NumH      : Integer = 0;
  103.  PTOOLTIM_NumM      : Integer = 0;
  104.  PTOOLTIM_NumS      : Integer = 0;
  105.  
  106.  
  107.  
  108. { Internal Functions Begin Here ******************************************* }
  109.  
  110.  
  111. Procedure PTOOLTIM_Parse (VAR Test               : PTOOLTIM_Str_11;
  112.                           VAR Number_of_Elements : Integer);
  113.  
  114. Var
  115.    I, J, K, E : Byte;                          { Get elements of input }
  116.                                                { Any of the characters }
  117. Begin                                          { below may seperate    }
  118.      I := 1;                                   { the elements.         }
  119.      K := 1;
  120.      For E := 1 to 3 do
  121.          Begin
  122.               PTOOLTIM_Element [E] := ' ';
  123.               While (not (Test [I] in ['0' .. '9']))
  124.                 and (I <= Length (Test)) do
  125.                     Begin
  126.                          PTOOLTIM_Element [4] [K] := Test [I];
  127.                          K := K + 1;
  128.                          I := I + 1;
  129.                     End;
  130.               J := 1;
  131.               While (Test [I] in ['0' .. '9'])
  132.                 and (I <= Length (Test)) do
  133.                     Begin
  134.                          PTOOLTIM_Element [E] [J] := Test [I];
  135.                          J := J + 1;
  136.                          I := I + 1;
  137.                          Number_of_Elements := E;
  138.                          PTOOLTIM_Element [E] [0] := Char (J - 1);
  139.                     End;
  140.          End;
  141.      While I <= Length (Test) do
  142.            Begin
  143.                 PTOOLTIM_Element [4] [K] := Test [I];
  144.                 K := K + 1;
  145.                 I := I + 1;
  146.            End;
  147.      PTOOLTIM_Element [4] [0] := Char (K - 1);
  148. End;
  149.  
  150.  
  151.  
  152. Function PTOOLTIM_H_Check (Test : PTOOLTIM_Str_11) : Boolean;
  153.  
  154. Var                                      { Find out if the Element areas     }
  155.    Num_of_El : Integer;                  { represent a valid HH:MM:SS String }
  156.    Code      : Integer;                  { and set Number areas              }
  157.  
  158. Begin
  159.      PTOOLTIM_H_Check := True;
  160.      PTOOLTIM_Parse (Test, Num_of_El);
  161.      If (Num_of_El < 2) or
  162.         (Num_of_El > 3) then
  163.         PTOOLTIM_H_Check := False;
  164.      Val (PTOOLTIM_Element [1], PTOOLTIM_NumH, Code);
  165.      If Code <> 0 then PTOOLTIM_H_Check := False;
  166.      Val (PTOOLTIM_Element [2], PTOOLTIM_NumM, Code);
  167.      If Code <> 0 then PTOOLTIM_H_Check := False;
  168.      PTOOLTIM_NumS := 0;
  169.      If Num_of_El = 3 then
  170.              Val (PTOOLTIM_Element [3], PTOOLTIM_NumS, Code);
  171.      If (Pos ('p', PTOOLTIM_Element [4]) <> 0)
  172.      or (Pos ('P', PTOOLTIM_Element [4]) <> 0) then
  173.         If PTOOLTIM_NumH < 12  then
  174.            PTOOLTIM_NumH := PTOOLTIM_NumH + 12
  175.            else begin end
  176.      else
  177.         If PTOOLTIM_NumH = 12 then PTOOLTIM_NumH := PTOOLTIM_NumH - 12;
  178.      If (PTOOLTIM_NumH > 23) or
  179.         (PTOOLTIM_NumM > 59) or
  180.         (PTOOLTIM_NumS > 59) or
  181.         (PTOOLTIM_NumH < 0) or
  182.         (PTOOLTIM_NumM < 0) or
  183.         (PTOOLTIM_NumS < 0) then PTOOLTIM_H_Check := False;
  184. End;
  185.  
  186.  
  187. Function PTOOLTIM_Make_H : PTOOLTIM_Str_11;
  188.  
  189. Var                              { Transform the Number areas }
  190.    Output : String [11];         { into a HH:MM:SS String     }
  191.    Work   : String [2];
  192.  
  193. Begin
  194.      Case PTOOLTIM_HH_Disp of
  195.       12 : If PTOOLTIM_NumH > 12 then Str (PTOOLTIM_NumH - 12:2, Output)
  196.            else
  197.               If PTOOLTIM_NumH = 0 then Output := '12'
  198.               else
  199.                  Str (PTOOLTIM_NumH:2, Output);
  200.       24 : Str (PTOOLTIM_NumH:2, Output);
  201.       End; {Case}
  202.      If Output [1] = ' ' then Delete (Output, 1, 1);
  203.      Str (PTOOLTIM_NumM:2, Work);
  204.      If Work [1] = ' ' then Work [1] := '0';
  205.      Output := Output + ':' + Work;
  206.      If PTOOLTIM_SS_Disp <> ' ' then
  207.         Begin
  208.              Str (PTOOLTIM_NumS:2, Work);
  209.              If Work [1] = ' ' then Work [1] := '0';
  210.              If PTOOLTIM_SS_Disp = 'S' then Output := Output + ':' + Work
  211.                                        else Output := Output + '.' + Work;
  212.         End;
  213.      If PTOOLTIM_HH_Disp = 12 then
  214.      If PTOOLTIM_NumH < 12 then Output := Output + ' am'
  215.                            else Output := Output + ' pm';
  216.      PTOOLTIM_Make_H := Output;
  217. End;
  218.  
  219.  
  220. Function PTOOLTIM_Get_D_Days : Real;  { Get Decimal Days from Number area }
  221.  
  222. Begin
  223.      PTOOLTIM_Get_D_Days := (Int (PTOOLTIM_NumH) / 24)
  224.                           + (Int (PTOOLTIM_NumM) / 1440)
  225.                           + (Int (PTOOLTIM_NumS) / 86400.0);
  226. End;
  227.  
  228.  
  229. Function PTOOLTIM_Get_Decimal : Real;
  230.                                         { Get Decimal time from }
  231. Begin                                   { Number area           }
  232.      Case PTOOLTIM_D_Type of
  233.       'D' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days;
  234.       'H' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 24;
  235.       'M' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 1440;
  236.       'S' : PTOOLTIM_Get_Decimal := PTOOLTIM_GET_D_Days * 86400.0;
  237.       End; {Case}
  238. End;
  239.  
  240.  
  241.  
  242. Procedure PTOOLTIM_Get_Time;
  243.                                          { BIOS call to put current time }
  244. Type                                     { into Number areas             }
  245.     BiosCall = Record
  246.                Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
  247.                End;
  248.  
  249. Var
  250.     BiosRec : BiosCall;
  251.     Ah, Al  : Byte;
  252.  
  253. Begin
  254.      Ah := $2c;
  255.      With BiosRec do
  256.           Begin
  257.                Ax := Ah shl 8 + Al;
  258.           End;
  259.      Intr ($21, BiosRec);
  260.      With BiosRec do
  261.           Begin
  262.                PTOOLTIM_NumH := Cx shr 8;
  263.                PTOOLTIM_NumM := Cx mod 256;
  264.                PTOOLTIM_NumS := Dx shr 8;
  265.           End;
  266. End;
  267.  
  268.  
  269. {Called Functions Begin Here ******************************************** }
  270.  
  271.  
  272. FUNCTION PTTValid (Test : PTOOLTIM_Str_11) : Boolean;
  273.  
  274. BEGIN
  275.  
  276.      PTTValid := PTOOLTIM_H_Check (Test);
  277.  
  278. END;
  279.  
  280.  
  281. FUNCTION PTTHtoD (Input : PTOOLTIM_Str_11) : Real;
  282.  
  283. BEGIN
  284.  
  285.      If PTOOLTIM_H_Check (Input) then
  286.         PTTHtoD := PTOOLTIM_Get_Decimal;
  287.  
  288. END;
  289.  
  290.  
  291. FUNCTION PTTDtoH (Input : Real) : PTOOLTIM_Str_11;
  292.  
  293. BEGIN
  294.  
  295.      Case PTOOLTIM_D_Type of
  296.       'H' : Input := Input / 24;
  297.       'M' : Input := Input / 1440;
  298.       'S' : Input := Input / 86400.0;
  299.       End; {Case}
  300.      Input := Frac (Input);
  301.      PTOOLTIM_NumH := Trunc (Input * 24.001);
  302.      PTOOLTIM_NumM := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)) * 1440.001);
  303.      PTOOLTIM_NumS := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)
  304.                                     - (Int (PTOOLTIM_NumM) / 1440))
  305.                                         * 86400.001);
  306.      PTTDtoH := PTOOLTIM_Make_H;
  307.  
  308. END;
  309.  
  310.  
  311. FUNCTION PTTHtoH (Input : PTOOLTIM_Str_11) : PTOOLTIM_Str_11;
  312.  
  313. BEGIN
  314.  
  315.      If PTOOLTIM_H_Check (Input) then
  316.         PTTHtoH := PTOOLTIM_Make_H;
  317.  
  318. END;
  319.  
  320.  
  321. FUNCTION PTTAdd (Input : PTOOLTIM_Str_11;
  322.                  Number : Real) : PTOOLTIM_Str_11;
  323.  
  324. BEGIN
  325.  
  326.      If PTOOLTIM_H_Check (Input) then
  327.         PTTAdd := PTTDtoH (PTTHtoD (Input) + Number);
  328.  
  329. END;
  330.  
  331.  
  332. FUNCTION PTTComp (Minuend, Subtrahend : PTOOLTIM_Str_11) : Real;
  333.  
  334. VAR
  335.  
  336.    HoldNum : Real;
  337.  
  338. BEGIN
  339.  
  340.      HoldNum := PTTHtoD (Minuend);
  341.      PTTComp := HoldNum - PTTHtoD (Subtrahend);
  342.  
  343. END;
  344.  
  345.  
  346. FUNCTION PTTHCurr : PTOOLTIM_Str_11;
  347.  
  348. BEGIN
  349.  
  350.      PTOOLTIM_Get_Time;
  351.      PTTHCurr := PTOOLTIM_Make_H;
  352.  
  353. END;
  354.  
  355.  
  356. FUNCTION PTTDCurr : Real;
  357.  
  358. BEGIN
  359.  
  360.      PTOOLTIM_Get_Time;
  361.      PTTDCurr := PTOOLTIM_Get_Decimal;
  362.  
  363. END;
  364.